home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / smaltalk.lha / smalltalk-1.1.1 / stix / Window.st < prev    next >
Text File  |  1991-09-12  |  6KB  |  235 lines
  1. "======================================================================
  2. |
  3. | Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  4. | Written by Steve Byrne.
  5. |
  6. | This file is part of GNU Smalltalk.
  7. |
  8. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  9. | under the terms of the GNU General Public License as published by the Free
  10. | Software Foundation; either version 1, or (at your option) any later version.
  11. | 
  12. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  13. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  14. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  15. | details.
  16. | 
  17. | You should have received a copy of the GNU General Public License along with
  18. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  19. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  20. |
  21.  ======================================================================"
  22.  
  23.  
  24. "
  25. |     Change Log
  26. | ============================================================================
  27. | Author       Date       Change 
  28. | sbyrne     24 May 90      created.
  29. |
  30. "
  31.  
  32. Drawable subclass: #Window
  33.        instanceVariableNames: ''
  34.        classVariableNames: ''
  35.        poolDictionaries: ''
  36.        category: 'X hacking'
  37. !
  38.     
  39.  
  40. !Window class methodsFor: 'instance creation'!
  41.     
  42. new: aDisplay
  43.     ^self new init: aDisplay id: aDisplay nextId
  44. !
  45.  
  46. new: aDisplay id: anId
  47.     ^self new init: aDisplay id: anId
  48.     
  49. !!
  50.  
  51.  
  52. !Window methodsFor: 'X protocol'!
  53.  
  54. createWindow: depth x: x y: y width: width height: height
  55.     borderWidth: borderInteger class: aWindowClass visual: aVisual
  56.     attrs: aBlock
  57.     | packet win |
  58.     win _ Window new: display.
  59.  
  60.     packet _ XWindowAttrPacket command: 1 aux: depth.
  61.     packet long: win id; long: self id; word: x; word: y.
  62.     packet uword: width; uword: height; uword: borderInteger.
  63.     packet word: (X map: aWindowClass into: #(CopyFromParent InputOutput InputOnly)).
  64.     packet long: (X maybeMap: aVisual into: #(CopyFromParent)).
  65.  
  66.     aBlock notNil
  67.     ifTrue: [ aBlock value: packet ]
  68.     ifFalse: [ packet noBits ].
  69.  
  70.     display socket bytes: packet done.
  71.     ^win    
  72. !
  73.  
  74. changeWindowAttributes: aBlock
  75.     | packet |
  76.  
  77.     packet _ XWindowAttrPacket command: 2.
  78.     packet long: self id.
  79.     aBlock notNil
  80.     ifTrue: [ aBlock value: packet ]
  81.     ifFalse: [ packet noBits ].
  82.     display socket bytes: packet done
  83. !
  84.  
  85. getWindowAttributes
  86.     | packet |
  87.  
  88.     packet _ XPacket command: 3.
  89.     packet long: self id.
  90.     display socket bytes: packet done.
  91.     
  92.     ^packet getResultAuxByte: #(backingStore (NotUseful WhenMapped Always))
  93.     using: #((visual visualId)
  94.              (class (nil InputOutput InputOnly) word)
  95.              (bitGravity bitGravity)
  96.              (winGravity winGravity)
  97.              (backingPlanes card32)
  98.              (backingPixel card32)
  99.              (saveUnder bool)
  100.              (mapIsInstalled bool)
  101.              (mapState (Unmapped Unviewable Viewable) byte)
  102.              (overrideRedirect bool)
  103.              (colormap colormap (None))
  104.              (allEventMasks bitMask EventNames)
  105.              (yourEventMask bitMask EventNames)
  106.              (doNotPropagateMask bitMask DeviceEventNames))
  107. !
  108.  
  109. destroyWindow
  110.     | packet |
  111.     packet _ XPacket command: 4.
  112.     display socket bytes: (packet long: self id; done)
  113. !
  114.  
  115. destroySubwindows
  116.     | packet |
  117.     packet _ XPacket command: 5.
  118.     display socket bytes: (packet long: self id; done)
  119. !
  120.  
  121. changeSaveSet: mode
  122.     | packet |
  123.     packet _ XPacket command: 6 aux: (X map: mode into: #(Insert Delete)).
  124.     display socket bytes: (packet long: self id; done)
  125. !    
  126.  
  127. reparentWindow: parentWindow x: x y: y
  128.     | packet |
  129.     packet _ XPacket command: 7.
  130.     display socket bytes: (packet long: self id; long: parentWindow id; 
  131.                   word: x; word: y; done)
  132. !
  133.  
  134. mapWindow
  135.     | packet |
  136.     packet _ XPacket command: 8.
  137.     display socket bytes: (packet long: self id; done)
  138. !
  139.  
  140. mapSubwindows
  141.     | packet |
  142.     packet _ XPacket command: 9.
  143.     display socket bytes: (packet long: self id; done)
  144. !
  145.  
  146. unmapWindow
  147.     | packet |
  148.     packet _ XPacket command: 10.
  149.     display socket bytes: (packet long: self id; done)
  150. !
  151.  
  152. unmapSubwindows
  153.     | packet |
  154.     packet _ XPacket command: 11.
  155.     display socket bytes: (packet long: self id; done)
  156.  
  157. !
  158.  
  159. configureWindow: aBlock
  160.     | packet |
  161.     packet _ XConfigPacket command: 12.
  162.     
  163.     aBlock notNil
  164.     ifTrue: [ aBlock value: packet ]
  165.     ifFalse: [ packet noBits ].
  166.  
  167.     display socket bytes: packet doneWord
  168.     
  169. !
  170.  
  171. circulateWindow: direction
  172.     | packet |
  173.     packet _ XPacket command: 13 
  174.              aux: (X map: direction
  175.                  into: #(RaiseLowest LowerHighest)).
  176.     display socket bytes: (packet long: self id; done)
  177. !
  178.  
  179. queryTree
  180.     | packet result numWins wins s |
  181.     packet _ XPacket command: 15. 
  182.     display socket bytes: (packet long: self id; done).
  183.  
  184.     s _ display socket.
  185.     s getReply
  186.     ifFalse: [ ^self ].
  187.     
  188.     result _ Dictionary new.
  189.     result at: #root put: s mappedId.
  190.     result at: #parent put: (s maybeMappedId: #(None)).
  191.     numWins _ s word.
  192.     s skipBytes: 14.    "there should be a better way"
  193.     wins _ Array new: numWins.
  194.     1 to: numWins do:
  195.     [ :i | wins at: i put: (s mappedId) ].
  196.     result at: #children put: wins.
  197.     ^result
  198. !
  199.  
  200. "not really here ""
  201. internAtom: aString ifExists: aFlag
  202.     | packet |
  203.     packet _ XPacket command: 16 
  204.     aux: (aFlag ifTrue: [ 1 ] ifFalse: [ 0 ]).
  205.     display socket bytes: (packet string: aString; done).
  206.     ^self notYetImplemented
  207. ""needs to return some information"
  208.  
  209. changeProperty: propertyAtom type: anAtom mode: aMode format: formatByte data: data
  210.     | packet |
  211.     "### Not completely done yet: doesn't handle non-8 bit data"
  212.     packet _ XPacket command: 18
  213.              aux: (X map: aMode
  214.                  into: #(Replace Prepend Append)).
  215.     packet long: self id; long: propertyAtom mapToId; long: anAtom mapToId.
  216.     packet byte: formatByte; pad; long: (data size); bytes: data.
  217.     display socket bytes: (packet done)
  218. !
  219.  
  220. deleteProperty: propertyAtom
  221.     | packet |
  222.     packet _ XPacket command: 19.
  223.     display socket bytes: (packet long: self id; long: propertyAtom mapToId; done)
  224. !!
  225.  
  226. !Window methodsFor: 'private'!
  227.  
  228. init: aDisplay id: anId
  229.     display _ aDisplay.
  230.     id _ anId.
  231.     Registry at: id put: self
  232. !!
  233.  
  234.  
  235.